//	COPYRIGHT (C) 1980 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

STATIC $( JOINHELP = "JOIN-HELP";
          CHAINHELP = "CHAIN-HELP";
          RINGHELP = "RING-HELP";
          LINKHELP = "LINK-HELP";
          BRANCHHELP = "BRANCH-HELP";
          UNJOINHELP = "UNJOIN-HELP";
          BORDHELP = "BORD-HELP";
          FREEVHELP = "FREEV-HELP";
          TAGHELP = "TAG-HELP";
          ERASEHELP = "ERASE-HELP";
          HRANGEHELP = "HRANGE-HELP";
          LNODEHELP = "LNODE-HELP";
          ARTYPEHELP = "ARTYPE-HELP";
          ATNAMEHELP = "ATNAME-HELP";
          SHOWHELP = "SHOW-HELP";
          DRAWHELP = "DRAW-HELP";
          DONEHELP = "DONE-HELP";
          HALTHELP = "HALT-HELP";
          ESHELP = "EDITSTRUC-HELP" $);
STATIC $( DONEFLAG = NIL; HALTFLAG = NIL $);

LET GETATNO(PROMPT,QQSTR,ALLOK) = VALOF
 $( STATIC $( ATNO = NIL; ATN = "THE NUMBER OF AN EXISTING ATOM";
              AATN = "THE NUMBER OF AN EXISTING ATOM, OR THE WORD 'ALL'" $);
 TRYPROMPT:
 UNLESS CONDPROMPT(PROMPT,(ALLOK -> AATN,ATN),0,QQSTR,(ALLOK -> NSTV,NTV)) DO
  RESULTIS -2;
 ATNO:=LITEMS![LPOSN+1];
 IF NEXTIS(STRTYPE) DO
  TEST STRCONTAIN(STROFNUM(ATNO),"ALL") THEN
   $( LOPITEM(); RESULTIS RHINF $)
  OR
   $(
   OUTSNUM(ATNO);
   OUTS(" ISN'T AN EXPECTED RESPONSE HERE*C*L");
   FLUSHLINE();
   GOTO TRYPROMPT
   $);
 IF ASSOC(ATNO,CTELIST) NE @NULL DO $( LOPITEM(); RESULTIS ATNO $);
 OUTS("THERE IS NO ATOM NUMBERED ");
 OUTNO(ATNO);
 NEWLINE(1);
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET INSUFLIST(N) = VALOF
 $(
 IF N LE NLISTLEFT DO RESULTIS FALSE;
 OUTS("NOT ENOUGH ROOM FOR THAT*C*L");
 RESULTIS TRUE
 $);

LET CJOIN() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL $);
 TRYPROMPT:
 ARG1:=GETATNO("FIRST ATOM:",JOINHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETATNO("SECOND ATOM:",JOINHELP,FALSE);
 IF ARG2<0 DO RETURN;
 IF ARG1=ARG2 DO
  $(
  OUTS("ATOM ");
  OUTNO(ARG1);
  OUTS(" CAN'T BE JOINED TO ITSELF*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 JOIN(ARG1,ARG2);
 UNLESS NEXTIS(EOLTYPE) DO CJOIN()
 $);

LET CCHAIN() BE
 $( STATIC $( ARG = NIL $);
 ARG:=GETPOSINT("CHAIN LENGTH:",CHAINHELP,FALSE);
 IF ARG<0 DO RETURN;
 IF INSUFLIST(ARG*[NCTEWORDS+3]-2) DO $( FLUSHLINE(); RETURN $);
 CHAIN(ARG);
 UNLESS NEXTIS(EOLTYPE) DO CCHAIN()
 $);

LET CRING() BE
 $( STATIC $( ARG = NIL $);
 ARG:=GETPOSINT("RING SIZE:",RINGHELP,FALSE);
 IF ARG<0 DO RETURN;
 IF INSUFLIST(ARG*[NCTEWORDS+3]) DO $( FLUSHLINE(); RETURN $);
 TEST ARG=1 THEN CHAIN(1) OR RING(ARG);
 UNLESS NEXTIS(EOLTYPE) DO CRING()
 $);

LET CLINK() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL; ARG3 = NIL $);
 ARG1:=GETATNO("FROM ATOM:",LINKHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETATNO("TO ATOM:",LINKHELP,FALSE);
 IF ARG2<0 DO RETURN;
 ARG3:=GETPOSINT("LENGTH OF LINK:",LINKHELP,FALSE);
 IF ARG3<0 DO RETURN;
 IF INSUFLIST(ARG3*[NCTEWORDS+3]+2) DO $( FLUSHLINE(); RETURN $);
 LINK(ARG1,ARG2,ARG3);
 UNLESS NEXTIS(EOLTYPE) DO CLINK()
 $);

LET CBRANCH() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL $);
 ARG1:=GETATNO("FROM ATOM:",BRANCHHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETPOSINT("LENGTH OF BRANCH:",BRANCHHELP,FALSE);
 IF ARG2<0 DO RETURN;
 IF INSUFLIST(ARG2*[NCTEWORDS+3]) DO $( FLUSHLINE(); RETURN $);
 BRANCH(ARG1,ARG2);
 UNLESS NEXTIS(EOLTYPE) DO CBRANCH()
 $);

LET CUNJOIN() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL $);
 TRYPROMPT:
 ARG1:=GETATNO("FIRST ATOM:",UNJOINHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETATNO("SECOND ATOM:",UNJOINHELP,FALSE);
 IF ARG2<0 DO RETURN;
 UNLESS UNJOIN(ARG1,ARG2) DO
  $(
  OUTS("ATOM ");
  OUTNO(ARG1);
  OUTS(" AND ATOM ");
  OUTNO(ARG2);
  OUTS(" AREN'T CONNECTED*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 UNLESS NEXTIS(EOLTYPE) DO CUNJOIN()
 $);

LET CBORD() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL; ARG3 = NIL $);
 TRYPROMPT:
 ARG1:=GETATNO("FIRST ATOM:",BORDHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETATNO("SECOND ATOM:",BORDHELP,FALSE);
 IF ARG2<0 DO RETURN;
 IF ARG1=ARG2
  $(
  OUTS("ATOM ");
  OUTNO(ARG1);
  OUTS("CAN'T HAVE A BOND ORDER TO ITSELF*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 ARG3:=GETNONNEGINT("BOND ORDER:",BORDHELP,TRUE);
 IF ARG3<0 DO RETURN;
 IF ARG3=PLUSINF DO ARG3:=-1;
 IF INSUFLIST(ABS[ARG3]*2) DO $( FLUSHLINE(); RETURN $);
 BORD(ARG1,ARG2,ARG3);
 UNLESS NEXTIS(EOLTYPE) DO CBORD()
 $);

LET CFREEV() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL $);
 ARG1:=GETATNO("ATOM:",FREEVHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETNONNEGINT("FREE VALENCE:",FREEVHELP,FALSE);
 IF ARG2<0 DO RETURN;
 IF INSUFLIST(ARG2) DO $( FLUSHLINE(); RETURN $);
 FREEV(ARG1,ARG2);
 UNLESS NEXTIS(EOLTYPE) DO CFREEV()
 $);

LET CTAG() BE
 $( STATIC $( ARG = NIL $);
 ARG:=GETATNO("ATOM:",TAGHELP,FALSE);
 IF ARG<0 DO RETURN;
 TAG(ARG);
 UNLESS NEXTIS(EOLTYPE) DO CTAG()
 $);

LET CERASE() BE
 $(

 LET ERASENAME(ATNO) BE ATNAME(ATNO,CONS(NUMOFSTR("C"),@NULL));

 LET ERASEFV(ATNO) BE FREEV(ATNO,0);

 LET ERASEHR(ATNO) BE HRANGE(ATNO,1,0);

 LET ERASELN(ATNO) BE LNODE(ATNO,-1,0);

 STATIC $( ATPROPCOMVEC = TABLE 7,
                          "ATNAME",@ERASENAME,
                          "HRANGE",@ERASEHR,
                          "FREEV",@ERASEFV,
                          "TAG",@UNTAG,
                          "LNODE",@ERASELN,
                          "ARTYPE",@ERASEAROM,
                          "ATOM",@DELAT,0;
           ERASEQSTR="ATNAME HRANGE FREEV TAG LNODE ARTYPE ATOM";
           ATNO = NIL; ERASOR = NIL; ALLATS = NIL $);
 ERASOR:=PROMPTSELECT("WHAT TO ERASE:",ERASEQSTR,0,ERASEHELP,
                      ATPROPCOMVEC,FALSE);
 IF ERASOR=0 DO RETURN;
 ERASOR:=!ERASOR;
 TRYPROMPT:
 ATNO:=GETATNO("WHICH ATOM?:",ERASEHELP,TRUE);
 IF ATNO<0 DO RETURN;
 TEST ATNO=RHINF THEN
  $(
  ALLATS:=MAPCAR(CTELIST,CAR);
  MAPC(ALLATS,ERASOR);
  UNLIST(ALLATS)
  $)
 OR ERASOR(ATNO);
 IF NEXTIS(NUMTYPE) DO GOTO TRYPROMPT;
 UNLESS NEXTIS(EOLTYPE) DO CERASE()
 $);

LET CHRANGE() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL; ARG3 = NIL $);
 ARG1:=GETATNO("ATOM:",HRANGEHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETNONNEGINT("MINIMUM NUMBER OF H'S:",HRANGEHELP,FALSE);
 IF ARG2<0 DO RETURN;
 ARG3:=GETNONNEGINT("MAXIMUM NUMBER OF H'S:",HRANGEHELP,TRUE);
 IF ARG3<0 DO RETURN;
 TEST ARG2>ARG3 THEN HRANGE(ARG1,ARG3,ARG2) OR HRANGE(ARG1,ARG2,ARG3);
 UNLESS NEXTIS(EOLTYPE) DO CHRANGE()
 $);

LET CLNODE() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL; ARG3 = NIL $);
 ARG1:=GETATNO("ATOM:",LNODEHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=GETPOSINT("MINIMUM LENGTH:",LNODEHELP,FALSE);
 IF ARG2<0 DO RETURN;
 ARG3:=GETPOSINT("MAXIMUM LENGTH:",LNODEHELP,TRUE);
 IF ARG3<0 DO RETURN;
 TEST ARG2>ARG3 THEN LNODE(ARG1,ARG3,ARG2) OR LNODE(ARG1,ARG2,ARG3);
 UNLESS NEXTIS(EOLTYPE) DO CLNODE()
 $);

LET CARTYPE() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL $);
 ARG1:=GETATNO("ATOM:",ARTYPEHELP,FALSE);
 IF ARG1<0 DO RETURN;
 ARG2:=PROMPTSELECT("AROMATIC OR NON-AROMATIC:","AROMATIC NON-AROMATIC",0,
                    ARTYPEHELP,[TABLE 2,"AROMATIC",1,"NON-AROMATIC",2,0],FALSE);
 IF ARG2=0 DO RETURN;
 TEST ARG2=1 THEN AROM(ARG1) OR NONAROM(ARG1);
 UNLESS NEXTIS(EOLTYPE) DO CARTYPE()
 $);

LET CATNAME() BE
 $( STATIC $( ARG1 = NIL; ARG2 = NIL; POLY = NIL; HXTAB = TABLE 2,"H","X";
              HXSTR = "PLEASE DON'T USE THE NAMES H OR X IN POLYNAMES" $);
 ARG1:=GETATNO("ATOM:",ATNAMEHELP,FALSE);
 IF ARG1<0 DO RETURN;
 NAMEPROMPT:
 UNLESS CONDPROMPT("ATOM NAME:",
                   "AN ATOM NAME, OR A LEFT PARENTHESIS TO BEGIN A POLYNAME",0,
                   ATNAMEHELP,SLTV) DO RETURN;
 ARG2:=LITEMS!LPOSN;
 TEST ARG2=STRTYPE THEN
  $(
  IF BADNAME([TABLE 1,"H"],"PLEASE DON'T USE THE NAME H AS AN ATOM NAME") DO
   $( FLUSHLINE(); GOTO NAMEPROMPT $);
  ATNAME(ARG1,CONS(LITEMS![LPOSN+1],@NULL));
  LOPITEM()
  $)
 OR
  $(
  LOPITEM();
  PNAMEPROMPT:
  UNLESS CONDPROMPT("(POLY)ATOM NAME:","ATOM NAME",0,ATNAMEHELP,STV) DO RETURN;
  IF BADNAME(HXTAB,HXSTR) DO $( FLUSHLINE(); GOTO PNAMEPROMPT $);
  POLY:=CONS(LITEMS![LPOSN+1],@NULL);
  LOPITEM();
  WHILE CONDPROMPT("(POLY)ATOM NAME:",
                   "AN ATOM NAME, OR A RIGHT PARENTHESIS OR CARRIAGE RETURN*
                    **C*LTO INDICATE THAT THE POLYNAME IS COMPLETE",0,
                   ATNAMEHELP,SRTV) DO
  TEST NEXTIS(RPARTYPE) THEN $( LOPITEM(); BREAK $)
  OR
   TEST BADNAME(HXTAB,HXSTR) THEN $( FLUSHLINE(); LOOP $)
   OR $( POLY:=CONS(LITEMS![LPOSN+1],POLY); LOPITEM() $);
  ATNAME(ARG1,DREVERSE(POLY))
  $);
 UNLESS NEXTIS(EOLTYPE) DO CATNAME()
 $);

GET "ESSHDR.BCL[1,35]"

LET CSHOW() BE
 TEST QRESPONSE("NO ARGUMENTS FOR SHOW",0,SHOWHELP) THEN RETURN
 OR
  TEST NEXTIS(EOLTYPE) BITOR NEXTIS(PSEOLTYPE) THEN $( NEWLINE(1); SHOW(0) $)
  OR $( FLUSHLINE(); NEWLINE(1); SHOW(0) $);

LET CDONE() BE
 TEST QRESPONSE("NO ARGUMENTS FOR DONE",0,DONEHELP) THEN RETURN
 OR
  TEST NEXTIS(EOLTYPE) BITOR NEXTIS(PSEOLTYPE) THEN DONEFLAG:=TRUE
  OR $( FLUSHLINE(); DONEFLAG:=TRUE $);

LET CHALT() BE
 TEST QRESPONSE("NO ARGUMENTS FOR HALT",0,HALTHELP) THEN RETURN
 OR
  TEST NEXTIS(EOLTYPE) BITOR NEXTIS(PSEOLTYPE) THEN HALTFLAG:=TRUE
  OR $( FLUSHLINE(); HALTFLAG:=TRUE $);

LET CDRAW() BE
 $( STATIC $( DTYPE = NIL; OUTFILE = NIL; FILEOPEN = NIL; FILEEMPTY = NIL;
              OOUT = NIL $);

 LET CALLDRAW(OUTFILE) BE
  $(
  UNLESS FILEOPEN DO RETURN;
  IF FILEEMPTY DO
   $(
   ENDWRITE(OUTFILE);
   DELETEFILE(SC1FILENAME(),CGEXT);
   RETURN
   $);
  OOUT:=OUTPUT;
  OUTPUT:=OUTFILE;
  OUTS("-1000*C*L");
  OUTCH(ESSEP);
  WRITEMYRET();
  OUTSNUM(STRUCTYPE);
  SPACES(1);
  OUTSNUM(STRUCNAME);
  SPACES(1);
  OUTSNUM(ORIGSTRUCNAME);
  SPACES(1);
  OUTNOS(FIRSTFREE);
  OUTNOS(CHUNKIX);
  OUTNOS(ESSIX);
  OUTNOL(TERMTYPE);
  WRITEESSTRUC();
  LINEOUT();
  ENDWRITE(OUTPUT);
  OUTPUT:=OOUT;
  STARTCGPART("DRAW")
  $);

 FILEOPEN:=FALSE;
 FILEEMPTY:=TRUE;
 TRYPROMPT:
 DTYPE:=PROMPTSELECT("TYPE OF DRAWING:","NUMBERED ATNAMED",0,DRAWHELP,
                     [TABLE 2,"NUMBERED",1,"ATNAMED",2,0],FALSE);
 IF DTYPE=0 DO $( CALLDRAW(OUTFILE); RETURN $);
 UNLESS FILEOPEN DO
  $(
  OUTFILE:=CREATEFILE("DSK",SC1FILENAME(),CGEXT);
  OOUT:=OUTPUT;
  OUTPUT:=OUTFILE;
  WRITERETTOME("EDITS");
  OUTNON(-TERMTYPE,5);
  NEWLINE(1);
  OUTPUT:=OOUT;
  FILEOPEN:=TRUE
  $);
 TEST ESDRAW([DTYPE=1],OUTFILE,0) THEN FILEEMPTY:=FALSE
 OR FLUSHLINE();
 UNLESS NEXTIS(EOLTYPE) DO GOTO TRYPROMPT;
 CALLDRAW(OUTFILE);
 $);

LET CCOPY() BE
 $( STATIC $( OIN = NIL; OLDDEF = NIL; SUCCEEDED = NIL;
              COPQVEC = [TABLE 2,"THE NAME OF A DEFINED",0] $);
 COPQVEC!2:=STROFNUM(STRUCTYPE);
 UNLESS CONDPROMPT("DEFINED NAME:",0,COPQVEC,"COPY-HELP",STV) DO RETURN;
 OLDDEF:=LITEMS![LPOSN+1];
 SWAPLITEMS();
 OIN:=INPUT;
 INPUT:=FINDFILE("DSK",TOPFILENAME(),CGEXT);
 SUCCEEDED:=([FINDSEG(CHUNKSEP,ESHEADSTR)>0] ->
              [FINDSEG(ESSEP,STROFNUM(OLDDEF))>0],FALSE);
 IF SUCCEEDED DO $( LINEIN(""); SUCCEEDED:=[STRUCTYPE=LOPITEM()] $);
 IF SUCCEEDED DO $( CLEAR(); READESSTRUC() $);
 SWAPLITEMS();
 ENDREAD(INPUT);
 INPUT:=OIN;
 TEST SUCCEEDED THEN LOPITEM()
 OR
  $(
  OUTS("I DON'T BELIEVE YOU HAVE DEFINED ");
  PIART(STROFNUM(STRUCTYPE));
  OUTS(" CALLED ");
  OUTSNUM(OLDDEF);
  OUTS(".*C*L");
  FLUSHLINE()
  $)
 $);

STATIC $( ESCOMVEC = TABLE 19,
                     "CHAIN", @CCHAIN,
                     "RING",  @CRING,
                     "BRANCH",@CBRANCH,
                     "LINK",  @CLINK,
                     "JOIN",  @CJOIN,
                     "BORD",  @CBORD,
                     "ATNAME",@CATNAME,
                     "HRANGE",@CHRANGE,
                     "FREEV", @CFREEV,
                     "TAG",   @CTAG,
                     "LNODE", @CLNODE,
                     "ARTYPE",@CARTYPE,
                     "UNJOIN",@CUNJOIN,
                     "ERASE", @CERASE,
                     "SHOW",  @CSHOW,
                     "DRAW",  @CDRAW,
                     "GET",   @CCOPY,
                     "DONE",  @CDONE,
                     "HALT",  @CHALT, 0 $);
STATIC $( ESCOMHELPVEC = TABLE 3,
          "CHAIN  RING   BRANCH LINK   JOIN   BORD",
          "ATNAME HRANGE FREEV  TAG    LNODE  ARTYPE",
          "UNJOIN ERASE  SHOW   DRAW   GET    DONE   HALT" $);


LET EDITSTRUC() = VALOF
 $(
 DONEFLAG:=FALSE;
 HALTFLAG:=FALSE;
  $(
  [![PROMPTSELECT(">",0,ESCOMHELPVEC,ESHELP,ESCOMVEC,TRUE)]]();
  IF DONEFLAG DO RESULTIS TRUE;
  IF HALTFLAG DO RESULTIS FALSE
  $) REPEAT
 $);

